COMMENT ⊗   VALID 00006 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	BEGIN "CONTRL"
 00006 00003		BITS IN STATBITS FOR COMMAND DECODER
 00009 00004	HERE ARE OUR MESSAGE PROCEDURES
 00018 00005	MAIN PROGRAM STARTS HERE
 00021 00006	EXCUTE TYPED COMMANDS
 00024 ENDMK
⊗;
BEGIN "CONTRL"
REQUIRE "EDGLIB.REL[SYS,HE]" LIBRARY;
REQUIRE "HELIB.REL[1,3]" LIBRARY;
REQUIRE 100 SYSTEM_PDL;
REQUIRE 700 STRING_SPACE;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "EDGE[SYS,HE]" LOAD_MODULE;
REQUIRE "MISEDG[SYS,HE]" LOAD_MODULE;
REQUIRE "SCANER[SYS,HE]" LOAD_MODULE;
REQUIRE "INNER[SYS,HE]" LOAD_MODULE;

DEFINE CX="12",TTY="1", LPT="2",
	CR="'15", LF="'12", CRLF="CR&LF", TAB="'11", TJOB="EQU(""TTY"",JOB)";
SAFE INTEGER ARRAY LPSFRE[1:1000];
PRELOAD_WITH "DISK","SETVAL","FIND","FIT","COMPACT","REJECT",
	"RELOOK","FINE","GETDATA","GETVAL","GLBDMP","GETSTATUS";
SAFE STRING ARRAY COMND[0:CX];
PRELOAD_WITH 1,'32,6,6,6,6,6,6,6,2,4,6;
SAFE INTEGER ARRAY STATBITS[0:CX];
SHORT INTEGER I,J,BRK,ARG,TARG,STATUS,BITS, ARGT;
EXTERNAL SHORT INTEGER XSTRT, YSTRT, TVWORD, PTYDPY, DISSIZ,INIT;
BOOLEAN FLAGX, AFLAG, FLAG, FLAGY;
STRING ANS, VERB, ARGSTR, ARGTWO, DSKSTRING, INP;
LABEL INPT, INPTX, ERRCOM, ERRARG, XEQL;
EXTERNAL BOOLEAN ACCOMINIT, EDGINIT;
INTERNAL STRING JOB;
ITEMVAR IARG, T;
INTERNAL SET FNDBLB;

EXTERNAL BOOLEAN PROCEDURE LOOK(REFERENCE ITEMVAR ARG; REFERENCE INTEGER ING;
	INTEGER X, Y);
EXTERNAL INTEGER PROCEDURE XGETD(LIST OBJS; STRING JOB);
EXTERNAL INTEGER PROCEDURE XGETS(LIST OBJS;REAL TOP,BOT,LFT,RT;STRING JOB);
EXTERNAL PROCEDURE INITLPS(INTEGER A);
EXTERNAL PROCEDURE DISINT;
EXTERNAL BOOLEAN PROCEDURE INITDK(STRING NAME);
EXTERNAL PROCEDURE SEINT(INTEGER A, B, C, D, E);
EXTERNAL BOOLEAN PROCEDURE EDGE_KKP(REFERENCE ITEMVAR A;REFERENCE INTEGER S);
EXTERNAL  PROCEDURE CURVE(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL  PROCEDURE REJSUB(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL  PROCEDURE COMP(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL  PROCEDURE XFINE(REFERENCE ITEMVAR ARG;REFERENCE INTEGER STATUS);
EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY A);
EXTERNAL BOOLEAN PROCEDURE SUBLNK(STRING FOO);
EXTERNAL PROCEDURE INTINT(BOOLEAN A,B,C);
EXTERNAL INTEGER PROCEDURE SLINK(STRING NAME);
EXTERNAL PROCEDURE INITTV;
EXTERNAL PROCEDURE DEFLT;
EXTERNAL PROCEDURE INTWAIT;
COMMENT		BITS IN STATBITS FOR COMMAND DECODER
1	NO ARGUMENTS
2	ONE ARGUMENT EXISTS
4	ARGUMENT IS NUMBER
10	SECOND ARGUMENT EXISTS
20	SECOND ARGUMENT IS NUMBER;

COMMENT	GET VALUE OF VARIABLE;

SIMPLE PROCEDURE GETVAL(STRING ARGSTR; REFERENCE BOOLEAN FLAG);
	BEGIN SHORT INTEGER I, FLG;
	REAL J;
	FLG ← FALSE;
	IF FLAG←(I←SLINK(ARGSTR))>0 THEN
		START_CODE DEFINE MOVE="'200000000000";
		MOVE 1,I;
		MOVE 1,(1);
		MOVEM 1,I;
		MOVEM 1,J;
		MOVM 2,1;
		TLNE 2,'777000;
		SETOM FLG;
		END ELSE RETURN;
	SETFORMAT(10,4);
	OUTSTR((IF ¬FLG THEN (CVOS(I)&CVS(I)) ELSE (CVF(J)))&CRLF);
	FLAG ← TRUE;
	END;

SIMPLE INTEGER PROCEDURE FOOL(REAL A);
	START_CODE DEFINE MOVE="'200000000000";
	MOVE 1,A;
	END;

COMMENT		SCAN ONE LINE FOR NEXT WORD OR NUMBER
		STRING A IS EATEN AS SCANNED
		B IS BREAK CHAR
		FLAGX (GLOBAL) IS TRUE IF STRING IS A NUMBER
		FLAGY (GLOBAL) IS TRUE IF A FLOATING POINT NUMBER IS SEEN;

SIMPLE STRING PROCEDURE SCN(REFERENCE STRING A; REFERENCE SHORT INTEGER B);
	BEGIN STRING FOO, FA;
	SHORT INTEGER C;
	SCAN(A,5,B);
	FA ← FOO ← SCAN(A,1,B);
	SCAN(FA,2,C);
	FLAGX ← ¬C;
	SCAN(FA←FOO,3,C);
	FLAGY←C;
	RETURN(FOO);
	END;
COMMENT	HERE ARE OUR MESSAGE PROCEDURES;

	COMMENT	RESPONSE PROCEDURE;

SIMPLE PROCEDURE RESP(ITEMVAR ARG; SHORT INTEGER STATUS; STRING NAME);
	IF TJOB THEN
		BEGIN
		AFLAG ← TRUE;
		OUTSTR(NAME&(IF ARG=NIL THEN " NIL" ELSE " "
			&CVS(CVN(ARG)))&" "&
			(IF STATUS≥0 THEN CVOS(STATUS) ELSE
			CVS(STATUS))&CRLF);
		END ELSE ISSUE(5,"EDGE",JOB,
			MESSAGE RESPONSE(NAME,CVN(ARG),STATUS));

DEFINE PROC(A,B)="
	MESSAGE PROCEDURE A(ITEMVAR ARG);
		BEGIN ITEMVAR T;
		T ← ARG;
		DO 	BEGIN
			B(ARG,STATUS←0);
			RESP(ARG,STATUS,""A"");
			IF T=EVERY∧ARG≠NIL THEN ARG←T;
			END UNTIL T≠EVERY∨ARG=NIL;
		END";

MESSAGE PROCEDURE FIND(ITEMVAR ARG);
	BEGIN ITEMVAR T;
	T ← ARG;
	DO	BEGIN
		EDGE_KKP(ARG,STATUS);
		IF T=EVERY∧ARG≠NIL THEN ARG←T;
		END  UNTIL T≠EVERY∨ARG=NIL;
	IF STATUS≥0 THEN STATUS←-1;
	RESP(NIL,STATUS,"FIND");
	IF ARG=NIL THEN XSTRT←YSTRT←0;
	END;

PROC(FIT,CURVE);
PROC(COMPACT,COMP);
PROC(REJECT,REJSUB);
PROC(FINE,XFINE);

MESSAGE PROCEDURE RELOOK(ITEMVAR ARG; INTEGER X,Y);
	BEGIN
	LOOK(ARG,STATUS,X,Y);
	RESP(ARG,STATUS,"RELOOK");
	END;

SIMPLE MESSAGE PROCEDURE XEQ(STRING ARGSTR; REFERENCE BOOLEAN FLAG);
	FLAG←¬SUBLNK(ARGSTR);

SIMPLE MESSAGE PROCEDURE SETVAL(STRING AR; INTEGER A;
		REFERENCE BOOLEAN F);
	BEGIN
	EDGINIT ← FALSE;
	IF F ← (I ← SLINK(AR))>0 THEN
		START_CODE DEFINE MOVE="'200000000000";
		MOVE 1,A;
		MOVE 2,I;
		MOVEM 1,(2);
		END;
	END;

MESSAGE PROCEDURE GETDATA(LIST OBJS; REFERENCE BOOLEAN FLAG);
	BEGIN
	FLAG ← ¬XGETD(OBJS, JOB);
	END;

MESSAGE PROCEDURE GETSTATUS(LIST OBJS;REAL TOP,BOT,LEFT,RT;
		REFERENCE BOOLEAN FLAG);
	BEGIN
	FLAG ← ¬XGETS(OBJS,TOP,BOT,LEFT,RT, JOB);
	END;

INTERNAL PROCEDURE RESTART;
	BEGIN
	AFLAG←TRUE;
	DISINT;
	SEINT(0,0,0,0, 0);
	INITLPS(GIOWD(LPSFRE));
	INITTV;
	INP ← NULL;
	DEFLT;
	END;

SIMPLE MESSAGE PROCEDURE DISK(STRING NAME; REFERENCE BOOLEAN FLAG);
	FLAG ← INITDK(NAME);

INTERNAL PROCEDURE START;
	XSTRT ← YSTRT ← 0;
COMMENT MAIN PROGRAM STARTS HERE;

	PTYDPY ← DISDEV;
	ACCOMINIT ← INIT ← FALSE;
	SETBREAK(1,LF&" ,",NULL,"I");
	SETBREAK(2,"0123456789.-",NULL,"X");
	SETBREAK(3,".",NULL,"I");
	SETBREAK(4,LF,"","IA");
	SETBREAK(5," ",NULL,"XR");
	TVWORD ← 0;
	PUT_DATA(0,0,"EDGE");
	YES_EDGE ← TRUE;
	INTINT(TRUE,FALSE,TRUE);
	RESTART;
INPT:	WHILE (I ← GET_ENTRY('40120,"","EDGE","")) DO 
		BEGIN
		JOB ← GET_DATA(1,I);
		I ← QUEUE('600,I);
		END;
	IF AFLAG THEN BEGIN OUTSTR("*"&CRLF); AFLAG ← FALSE; END;
	WHILE LENGTH(ANS←INCHSL(FLAGX))∧¬FLAGX DO
		BEGIN INP←INP&ANS&LF;ANS←NULL;END;
	IF ¬LENGTH(INP) THEN GO TO XEQL;
	JOB←"TTY";
	AFLAG ← TRUE;
	WHILE LENGTH(ANS←SCAN(INP,4,BRK)) DO
		BEGIN
		IF ¬LENGTH(VERB←SCN(ANS,BRK)) THEN GO TO INPTX;
		FOR I ← 0 STEP 1 UNTIL CX DO IF EQU(VERB,COMND[I]) THEN DONE;
		IF I>CX THEN GO TO ERRCOM;
		BITS ← STATBITS[I];
		IF BITS LAND 2 THEN
			BEGIN
			IF BRK=LF THEN GO TO ERRARG ELSE ARGSTR←SCN(ANS,BRK);
			IF BITS LAND 4 THEN IF FLAGX THEN
				ARG←(IF FLAGY THEN FOOL(REALSCAN(ARGSTR,LF))
				ELSE CVD(ARGSTR)) ELSE GO ERRARG ELSE
				ARGSTR ← ARGSTR[1 FOR 6];
			IF BITS LAND '10 THEN
				BEGIN
				IF BRK=LF THEN GO TO ERRARG ELSE
					ARGTWO←SCN(ANS,BRK);
				IF BITS LAND '20 THEN IF FLAGX THEN
					ARGT←(IF FLAGY THEN
						FOOL(REALSCAN(ARGTWO,LF))
					ELSE CVD(ARGTWO)) ELSE GO TO ERRARG
					ELSE ARGTWO ← ARGTWO[1 FOR 6];
				END;
			END;
		IARG ← IF ARG>0 THEN CVI(ARG) ELSE IF ARG=0 THEN NIL ELSE
			EVERY;
		FLAG ← TRUE;
COMMENT	EXCUTE TYPED COMMANDS;

		CASE I OF
			BEGIN

			BEGIN
			IF LENGTH(ANS) THEN
				BEGIN
				INP ← SCAN(ANS,5,BRK);
				DSKSTRING ← ANS[1 TO ∞-1];
				END;
			DISK(DSKSTRING,FLAG);
			IF ¬FLAG THEN
				OUTSTR(CRLF&DSKSTRING&" NOT FOUND"&CRLF);
			END;

			SETVAL(ARGSTR,ARGT, FLAG);
			FIND(IARG);
			FIT(IARG);
			COMPACT(IARG);
			REJECT(IARG);
			RELOOK(IARG,0,0);
			FINE(IARG);
			GETDATA(IF IARG=EVERY THEN CVLIST(FNDBLB) ELSE
				{{IARG}},FLAG);
			GETVAL(ARGSTR,FLAG);
			IF YES_CUR THEN ISSUE(7,"EDGE","CURVE",
				MESSAGE GLBDMP(IF IARG=EVERY THEN BLOBS
				ELSE {IARG})) ELSE
				OUTSTR("CURVE FITTER NOT AVAILABLE"&CRLF);
			GETSTATUS(IF IARG=EVERY THEN CVLIST(FNDBLB) ELSE
				{{IARG}},INTSCAN(ANS,BRK),INTSCAN(ANS,BRK),
				INTSCAN(ANS,BRK),INTSCAN(ANS,BRK),FLAG);
			END;
		IF ¬FLAG THEN 
ERRARG:			OUTSTR("ARG ERR"&TAB&ANS&CRLF);
INPTX:		END;
	GO TO INPT;

XEQL:	IF GET_ENTRY('40120,NULL,"EDGE",NULL) THEN GO TO INPT;
	IF LENGTH(ANS←INCHSL(FLAGX))∧¬FLAGX THEN
		BEGIN
		INP←INP&ANS&LF;
		GO TO INPT;
		END;
	INTWAIT;
	GO TO INPT;

ERRCOM:	IF SUBLNK(VERB) THEN OUTSTR("COM ERR "&VERB&CRLF);
	GO TO INPT;
	END;